home *** CD-ROM | disk | FTP | other *** search
/ Business Shareware / Business Shareware.iso / start / database / lib194 / errlog.prg < prev    next >
Encoding:
Text File  |  1992-11-13  |  15.7 KB  |  419 lines
  1. PROCEDURE ErrorLog
  2. *-------------------------------------------------------------------------------
  3. *-- Programmer : Peter Ripaldi (CIS: 70711,3420) (1-508-683-4987)
  4. *-- Date       : 08/23/1992
  5. *-- Notes      : Program to produce an error log on disk that is about
  6. *--            : 12k long. The idea is to provide as much information as
  7. *--            : possible about the system at the time of the error. On
  8. *--            : error you can print the screen to printer and/or disk
  9. *--            : if you uncomment the section(s). The error log on
  10. *--            : disk is called ERROR.LOG, each error session will
  11. *--            : add to the bottom of the previous error.
  12. *--            : Any suggestion to add, or if it helps
  13. *--            : let me know. Happy Erroring ?
  14. *-- Written for: dBASE IV 1.5  08/23/92
  15. *-- Rev. Hist. : 04/09/92 1.0 - none-  format from E_LOG.PRG
  16. *--            : Ideas from E_LOG.PRG    author unknown
  17. *--            :            ERR_TRAP.PRG author BILLG (BORBBS)
  18. *--            :            SPY_CAM      author dbf magazine
  19. *--            : 08/23/92 1.5 Added functions for ver 1.5
  20. *--            :              Save to screen before error msg on screen 
  21. *--            :              Append print screen to end of ERROR.LOG file
  22. *--            :              Send network msg, idea from Bob(IVYBURT) 
  23. *--            : 11/13/1992 -- modified seriously by Ken Mayer, allowing
  24. *--                            programmer calls to PRINTSCR and SCREEN, as
  25. *--                            well as network, by passing parms to the routine.
  26. *--                            Cleaned up the programming a lot. Removed 
  27. *--                            the need for as many memvars.
  28. *-- Calls......: PRINTSCR.BIN  Prints screen to printer if parameter is set
  29. *--            : SCREEN.BIN    Prints screen to disk if parameter is set
  30. *--              SURROUND()    Function below
  31. *--              CENTER        Procedure below
  32. *-- Called by..: Any
  33. *-- Usage......: on error do ErrorLog with error(),lineno(),program(),;
  34. *--                  alias(),memory()[,<lPrntScrn>[,<lScrn2Disk>[,<cNetId>]]]
  35. *-- Example....: on error do errorlog with error(),lineno(),program(),alias(),;
  36. *--                  memory(),.t.,.t.,"MAYER"
  37. *-- Returns....: None
  38. *-- Parameters.: error()    = dBASE Function
  39. *--              lineno()   = dBASE Function
  40. *--              program()  = dBASE Function
  41. *--              alias()    = dBASE Function
  42. *--              memory()   = dBASE Function
  43. *--              lPrntScrn  = logical -- print the screen?
  44. *--              lScrn2Disk = logical -- print the screen to disk?
  45. *--              cNetId     = Network ID for user on a NOVELL NETWORK
  46. *--                           to send a Network message to letting them
  47. *--                           know about this error.
  48. *-------------------------------------------------------------------------------
  49.    *-- Try to bring in as much of system before loading anything else
  50.    PARAMETER nError,nLineNo,cProgram,cAlias,nMemory,lPrntScrn,lScrn2Disk,cNetId
  51.  
  52.    *-- talk off so answers to IIF() dont go in ERROR.LOG file
  53.    cTalk = set("TALK")
  54.    set talk off
  55.  
  56.     *-- deal with optional parameters
  57.     nParms = pCount()  && how many parameters were passed?
  58.     if nParms < 8      && no Net Id
  59.         cNetId = ""
  60.     endif
  61.     if nParms < 7      && no lScrn2Disk parm
  62.         lScrn2Disk = .f.
  63.     endif
  64.     if nParms < 6      && no Print Screen parm
  65.         lPrntScrn = .f.
  66.     endif
  67.     
  68.    *-- Get copy of screen so we can restore it after were done
  69.    save screen to sError
  70.    activate screen
  71.  
  72.    *-- set up disk file ERROR.LOG
  73.    set alternate to
  74.  
  75.     *-- Let user know SOMETHING'S happening
  76.     x=surround(12,25,"rg+/r","An Error Has Occured -- Writing Log")
  77.     
  78.    *-- If already there add to it, incase of more errors next time runs prg
  79.    if file("ERROR.LOG")
  80.       set alternate to error.log additive
  81.    else
  82.    *-- If not there make one
  83.       set alternate to error.log
  84.    endif && file("ERROR.LOG")
  85.  
  86.    *-- Turn on ERROR.LOG file
  87.    set alternate on
  88.  
  89.    *-- Turn screen off
  90.    set console off
  91.  
  92.    *-- set date to 19xx format
  93.    set century on
  94.  
  95.    *-- Begin error logging information to disk
  96.    *
  97.    * Set up heading
  98.  ? "=========================================================================="
  99.  ? "=====                   Begin Errors Found                           ====="
  100.  ? "====="
  101.  ?? SPACE(10)+CDOW(DATE())+SPACE(10)+MDY(DATE())+SPACE(10)+(TIME())
  102.  ?? "  ====="
  103.  ? "=========================================================================="
  104.  ?
  105.  ? " Error / Program Information"
  106.  ? "------------------------------"
  107.  ? "    Error #      : " + LTRIM(STR(nError)) +"  "+ MESSAGE()
  108.  ? "    In Program   : " + cProgram
  109.  ? "    On Line #    : " + LTRIM(STR(nLineNo))
  110.  ? "    Catalog Name : " + LTRIM(CATALOG())
  111.  ?
  112.  ?
  113.  
  114.  ? " System Information"
  115.  ? "------------------------------"
  116.  ? "    Memory          : " + LTRIM(STR(nMemory))
  117.  ? "    Diskspace       : " + LTRIM(STR(DISKSPACE()))
  118.  ? "    Path            : " + GETENV("path")
  119.  ? "    Prompt          : " + GETENV("prompt")
  120.  ? "    ComSpec         : " + GETENV("comspec")
  121.  ? "    Operating Sys   : " + LTRIM(OS())
  122.  ? "    Dbase Version   : " + LTRIM(VERSION(0))
  123.  ? "    Dbase Path      : " + LTRIM(HOME())
  124.  ? "    Compile Error   : " + LTRIM(STR(CERROR()))
  125.  ? "    Color system    : " + iif(iscolor(),"Yes","No") 
  126.  ?
  127.  ?
  128.  
  129.  ? "  Database File Information "
  130.  ? "------------------------------"
  131.  ? "    DBF File        : " + DBF()
  132.  ? "    Alias Name      : " + cAlias
  133.  ? "    Work area       : " + LTRIM(STR(SELECT()))
  134.  ? "    Order           : " + ORDER()
  135.  ? "    Record #        : " + LTRIM(STR(RECNO()))
  136.  ? "    Field count     : " + LTRIM(STR(FLDCOUNT()))
  137.  ? "    Tag name        : " + LTRIM(TAG())
  138.  ? "    Tag count       : " + LTRIM(STR(TAGCOUNT()))
  139.  ? "    Tag number      : " + LTRIM(STR(TAGNO()))
  140.  ? "    MDX file        : " + LTRIM(MDX())
  141.  ? "    NDX file        : " + LTRIM(NDX())
  142.  ? "    Descending index: " + iif(descending(),"Yes","No") 
  143.  ?
  144.  ? "    For condition of mdx tag  : " + LTRIM(FOR())
  145.  ? "    Expression of mdx/ndx tag : " + LTRIM(KEY())
  146.  ? "    Unique Index              : " + iif(unique(),"Yes","No") 
  147.  ? "    Deleted                   : " + iif(deleted(),"Yes","No") 
  148.  ? "    Record Count              : " + LTRIM(STR(RECCOUNT()))
  149.  ?
  150.  *-- record size may not be right add 35 for header if wanted
  151.  ? "    Record Size     : " + LTRIM(STR(RECSIZE()))
  152.  ? "    Last Update     : " + DTOC(LUPDATE())
  153.  ? "    Last Seek Found : " + iif(found(),"Yes","No") 
  154.  ? "    End Of File     : " + iif(eof(),"Yes","No") 
  155.  ? "    Begin Of File   : " + iif(bof(),"Yes","No") 
  156.  ?
  157.  ?
  158.  
  159.  ? "  Program Information "
  160.  ? "------------------------------"
  161.  ? "    Number of parameters called : " + LTRIM(STR(PCOUNT()))
  162.  ?
  163.  ?
  164.  
  165.  ? " File / User / Network  Information"
  166.  ? "------------------------------"
  167.  ? "    On Network             : " + iif(network(),"Yes","No") 
  168.  ? "    DBF in state of change : " + iif(ismarked(),"Yes","No") 
  169.  ? "    User Access Level      : " + LTRIM(STR(ACCESS()))
  170.  ? "    Log in User Name       : " + USER()
  171.  ? "    Name of current User   : " + ID()
  172.  ? "    Changed by others      : " + iif(change(),"Yes","No") 
  173.  ? "    Completed Transaction  : " + iif(completed(),"Yes","No") 
  174.  ? "    Rollback  Successful   : " + iif(rollback(),"Yes","No") 
  175.  ? "    Record Lock            : " + iif(rlock(),"Yes","No") 
  176.  ? "    File Lock              : " + iif(flock(),"Yes","No") 
  177.  ? 
  178.  ?
  179.  ? " List of Users  "
  180.  ? "--------------------------------"
  181.  list users
  182.  ?
  183.  ?
  184.  ? " Screen Information "
  185.  ? "------------------------------"
  186.  ? "    Window        : " + WINDOW()
  187.  ? "    Pad           : " + PAD()
  188.  ? "    Popup         : " + POPUP()
  189.  ? "    Bar #         : " + LTRIM(STR(BAR()))
  190.  ? "    Prompt        : " + PROMPT()
  191.  ? "    Menu          : " + MENU()
  192.  ? "    Cursor Row    : " + LTRIM(STR(ROW()))
  193.  ? "    Cursor Column : " + LTRIM(STR(COL()))
  194.  ?
  195.  ?
  196.  
  197.  ? " Key Stroke Information "
  198.  ? "------------------------------"
  199.  ? "    Varread       : " + VARREAD()
  200.  ? "    Inkey         : " + LTRIM(STR(INKEY()))
  201.  ? "    Lastkey       : " + LTRIM(STR(LASTKEY()))
  202.  ? "    Readkey       : " + LTRIM(STR(READKEY()))
  203.  ?
  204.  
  205.  ? " Printer Information "
  206.  ? "------------------------------"
  207.  ? "    Print Status     : " + iif(printstatus(),"Yes","No") 
  208.  ? "    Print Column     : " + LTRIM(STR(PCOL()))
  209.  ? "    Print Row        : " + LTRIM(STR(PROW()))
  210.  ?
  211.  ?
  212.  
  213.  * List  Status, Memory, History .....
  214.  ? " Status Listing "
  215.  ? "----------------------------------------------"
  216.  ?
  217.  ?
  218.  list status
  219.  
  220.  ? " Memory Listing "
  221.  ? "----------------------------------------------"
  222.  ?
  223.  ?
  224.  list memory
  225.  ?
  226.  ?
  227.  
  228.  ? " History Listing "
  229.  ? "------------------------------------------------"
  230.  list history
  231.  ?
  232.  ?
  233.  * End of errors for this time
  234.  ? "=========================================================================="
  235.  ? "=====                  End of Errors Found                           ====="
  236.  ? "====="
  237.  ?? space(10)+cdow(date())+space(10)+mdy(date())+space(10)+(time())
  238.  ?? "  ====="
  239.  ? "=========================================================================="
  240.  * spaces to seperate error log for next time error happens
  241.  ?
  242.  ?
  243.  ?
  244.  ?
  245.  *-- All done with saving file close up error file
  246.    set alternate off
  247.    set alternate to
  248.    set console on
  249.    set century off
  250.  
  251.    *-----------------------------------------------------------------------
  252.     *-- optional stuff here
  253.     *-----------------------------------------------------------------------
  254.     restore screen from sError  && remove message to user ...
  255.    if lPrntScrn
  256.        *-- Print Screen First, uses printscr.bin
  257.       load printscr
  258.       call printscr
  259.       release module printscr
  260.    endif
  261.  
  262.    *-----------------------------------------------------------------------
  263.    *-- Print screen to disk?
  264.    *-----------------------------------------------------------------------
  265.    * Print screen to disk file called Erscreen.txt,  uses screen.bin 
  266.    * The "a" option will append to text file
  267.    if lScrn2Disk
  268.       load screen
  269.       call screen with "a", "Erscreen.txt"
  270.       release module screen
  271.       eject   && form feed to clear out printer ...
  272.  
  273.      *- Add screen to end of ERROR.LOG file
  274.      set alternate to error.log additive
  275.  
  276.      *-- Turn screen off
  277.      set console off
  278.  
  279.      *-- turn on ERROR.LOG file for heading
  280.      set alternate on
  281.      ? "Screen Dump of above error"
  282.      ? "-----------------------------------------------"
  283.      ?
  284.      *-- All done with heading close up ERROR.LOG file
  285.      set alternate off
  286.      set alternate to
  287.  
  288.      *-- Now add screen to end of ERROR.LOG file
  289.      load screen
  290.      call screen with "a", "ERROR.LOG"
  291.      release module screen
  292.      *-- all done 
  293.      set console on
  294.    endif  && lScrn2File
  295.  
  296.   *------------------------------------------------------------------------
  297.   *-- After all that, let's let the user know what happened
  298.   *------------------------------------------------------------------------
  299.   * For real fun use one of KenMayer's "Death March" Songs (MISC.PRG)
  300.   * Alert user for heart attack, Give a tone
  301.   set bell to 500,5
  302.   ?? chr(7)
  303.   set bell to 400,4
  304.   ?? chr(7)
  305.   *set bell to 500,5
  306.   *?? chr(7)
  307.   *set bell to 400,5
  308.   *?? chr(7)
  309.   *set bell to 500,5
  310.   *?? chr(7)
  311.   set bell to
  312.  
  313.    *-- Give user message, on error window
  314.    define window wError from 0,0 to 24,79 double
  315.    activate window wError
  316.    *-- sample message inspired by movie China Syndrome
  317.     do center with 6,80,"rg+/r","** E R R O R  L O G **"
  318.    do center with 10,80,"","An unscheduled event has happened."
  319.    do center with 12,80,"","The information has been stored to disk. "
  320.    do center with 14,80,"","Notify Programmer Immediately!"
  321.    do center with 16,80,"","You are being returned to the dot prompt, or"
  322.    do center with 18,80,"","(if using RUNTIME) being dropped to DOS."
  323.    do center with 20,80,"","Press a key to continue ..."
  324.    *-- Wait until user sees message
  325.    x=inkey(0) 
  326.  
  327.    *------------------------------------------------------------------
  328.    *-- Network message to programmer?
  329.    *------------------------------------------------------------------
  330.    if .not. isblank(cNetId)
  331.         * From Bob (IVYBURT)
  332.         * If you're on a network, option to send a message to network manager
  333.         * to notify of mentally deranged program.
  334.  
  335.      if network()=.t.
  336.         !SEND &cNetId " Help -- Program Crashed!" 
  337.      endif  && network()
  338.    endif  && .not. isblank(cNetId)
  339.  
  340.    *------------------------------------------------------------------
  341.    *-- done with window, shut-down
  342.    *------------------------------------------------------------------
  343.    deactivate window wError
  344.    release window wError
  345.    clear all
  346.    release all
  347. clear
  348. Cancel         && rather than returning user to where they were
  349.  
  350. *-------------------------------------------------------------------------------
  351. *-- Extra Functions called from above ...
  352. *-------------------------------------------------------------------------------
  353.  
  354. PROCEDURE Center
  355. *-------------------------------------------------------------------------------
  356. *-- Programmer..: Miriam Liskin
  357. *-- Date........: 05/24/1991
  358. *-- Notes.......: Centers text on the screen with @says
  359. *-- Written for.: dBASE IV, 1.1
  360. *-- Rev. History: This and all other procedures/functions listed in this
  361. *--               file attributed to Miriam Liskin came from "Liskin's
  362. *--               Programming dBASE IV Book". Very good, worth the money.
  363. *-- Calls.......: None
  364. *-- Called by...: Any
  365. *-- Usage.......: do center with <nLine>,<nWidth>,"<cColor>","<cText>"
  366. *-- Example.....: do center with 5,65,"RG+/GB","WARNING! This will blow up!"
  367. *--                  Note that the color field may be blank: ""
  368. *-- Returns.....: None
  369. *-- Parameters..: nLine  = Line or Row for @/Say
  370. *--               nWidth = Width of screen
  371. *--               cColor = Colors to be used ("Forg/Back") (may be nul "", in
  372. *--                           order to use the default colors of window/screen)
  373. *--               cText  = Message to center on screen
  374. *-------------------------------------------------------------------------------
  375.     
  376.     parameters nLine,nWidth,cColor,cText
  377.     private nCol
  378.     
  379.     nCol = (nWidth - len(cText)) /2
  380.     @nLine,nCol say cText color &cColor.
  381.     
  382. RETURN
  383. *-- EoP: Center
  384.  
  385. FUNCTION Surround
  386. *-------------------------------------------------------------------------------
  387. *-- Programmer..: Miriam Liskin
  388. *-- Date........: 05/24/1991
  389. *-- Notes.......: Displays a message surrounded by a box anywhere on 
  390. *--               the screen
  391. *-- Written for.: dBASE IV, 1.1
  392. *-- Rev. History: 04/19/1991 - Modified by Ken Mayer (KENMAYER) to a function
  393. *--               from original procedure
  394. *-- Calls.......: None
  395. *-- Called by...: Any
  396. *-- Usage.......: surround(<nLine>,<nColumn>,"<cColor>","<cText>")
  397. *-- Example.....: cDummy = surround(5,12,"RG+/GB",;
  398. *--                        "Processing ... Do not Touch!")
  399. *-- Returns.....: Nul/""
  400. *-- Parameters..: nLine   = Line to display "surrounded" message at
  401. *--               nColumn = Column for same (X,Y coordinates for @SAY)
  402. *--               cColor  = Color variable/colors
  403. *--               cText   = Text to be displayed inside box
  404. *-------------------------------------------------------------------------------
  405.     
  406.     parameters nLine,nColumn,cColor,cText
  407.     
  408.     cText = " " + trim(cText) + " "             && add spaces around text
  409.     @nLine-1,nColumn-1 to nLine+1,nColumn+len(cText) double;
  410.         color &cColor.                           && draw box
  411.     @nLine,nColumn say cText color &cColor.  && disp. text
  412.     
  413. RETURN "" 
  414. *-- EoF: Surround()
  415.  
  416. *-------------------------------------------------------------------------------
  417. *-- End of Program: ERRLOG.PRG
  418. *-------------------------------------------------------------------------------
  419.